home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / PRGMMING / M2PROTOS.ZIP / QCXM.MOD < prev    next >
Encoding:
Modula Implementation  |  1991-05-27  |  25.2 KB  |  791 lines

  1. (*# call(o_a_copy => off) *)
  2. (*%T _fcall *)
  3. (*# call(seg_name => QCxm) *)
  4. (*%E *)
  5. (*%F _fcall *)
  6. (*# call(seg_name => null) *)
  7. (*%E *)
  8. (*# module(implementation=>on) *)
  9. (*# data(seg_name => null) *)
  10. (*# data(const_assign => on) *)
  11. IMPLEMENTATION MODULE QCxm;
  12.  
  13.                      (* This JPI Modula-2 module is part of *)
  14.  
  15.                       (* QC -- a communications program *)
  16.                              (* by Carl Neiburger *)
  17.                               (* 169 N. 25th St.*)
  18.                           (* San Jose, Calif. 95116 *)
  19.  
  20.                          (* CompuServe No. 72336,2257 *)
  21.  
  22. IMPORT NFIO;
  23. FROM Str IMPORT Append, CardToString, Concat, Copy, Length, Pos, Delete, 
  24.     Insert;
  25. FROM QCcomm IMPORT ComAbort, ComTimedOut, CommRdData, CommRdDataTest, 
  26.     CommWrData, setXon, ack, eot, can, cee, esc, nak, soh, stx, syn, sub;
  27. FROM QCxmzero IMPORT BPtr, ZeroBlockProtos, CreateBlock, InterpretBlock, 
  28.     TelinkBlockType, BasicBlock;
  29. FROM QCdisp IMPORT DataLeft, DataRegisters, Errs, Packets, PressKey, 
  30.     PromptForString, QCDefPtr, ShowTransferTime, ShowErrorType, 
  31.     ShowFileName, ShowPacketSize, StartDisplay, StatusMessage, StopDisplay, 
  32.     IncrDataBytes, UpdateData, Yes, DisplayData, ShowTimeLeft,
  33.     AbortMsg, TimeoutAbortMsg, TimeoutMsg, ProtoType, YModem, Telink, 
  34.     CloseError, CreateError, OpenError, FlushLog; 
  35. FROM Lib IMPORT Fill;
  36. FROM CRC IMPORT DoCRC, DoCks, ChkProc;
  37. FROM UTIL IMPORT NUMSET, SBITSET, str10, str80, FiChars;
  38. FROM FioAsm IMPORT DiskFree, SetFileTime, PathTail;
  39. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  40. FROM PathFind IMPORT ParsePath;
  41. FROM Timer IMPORT StartTimer, ForTransfer, ForPacket;
  42. FROM MiscAsm IMPORT HI;
  43.  
  44. TYPE
  45.     RateValType = ARRAY BOOLEAN OF CARDINAL;
  46.     A2 = ARRAY[0..1] OF SHORTCARD;
  47.  
  48. CONST
  49.     MaxErrors = 10;
  50.     SendDelay = 10; (* number of seconds to wait for ack *)
  51.     RateVal = RateValType(18, 26);
  52.     XmProtos = ProtoSet{XModem, XModem1K, YModem, Telink};
  53.     OneKProtos = ProtoSet{XModem1K, YModem};
  54.     NoTransferMsg = 'Cannot start transfer.';
  55.     CancelMsg = 'Cancel received.';
  56.     BlockCrossover = 5*128+1; (* When using 1K protocol, switch to 128-byte *)
  57.                               (* blocks if there are fewer than this many   *)
  58.                               (* bytes left. *)
  59. VAR
  60.     Protocol   : ProtoType;
  61.     Buffer : BPtr;
  62.     ZeroBlock:    TelinkBlockType;
  63.     fi         :  NFIO.File;
  64.     BlockSize,
  65.     CRCvalue   : CARDINAL;
  66.     Aborting,
  67.     UsingCRC   : BOOLEAN;
  68.     UpdChk     : ChkProc;
  69.     BytesToGo, 
  70.     blockCount : LONGCARD;
  71.     MsgStr      : str80;
  72.  
  73. PROCEDURE GracefulAbort(message : str80);
  74. VAR i : SHORTCARD;
  75. BEGIN
  76.     WHILE CommRdData(0) < 0100H DO END; (* Flush *)
  77.     FOR i := 1 TO 8 DO
  78.          CommWrData(can)
  79.     END;
  80.     FOR i := 1 TO 8 DO
  81.          CommWrData(8H) (* backspace to clear receiver's buffer *)
  82.     END;
  83.     NFIO.Close(fi);
  84.     Aborting := TRUE;
  85.     StatusMessage(message, TRUE);
  86.     WHILE CommRdData(0) < 0100H DO END; (* Flush *)
  87. END GracefulAbort;
  88.  
  89. PROCEDURE ShowFileData(Name: ARRAY OF CHAR; Receiving: BOOLEAN);
  90. BEGIN
  91.     ShowFileName(Name, Receiving);
  92.     ShowErrorType(UsingCRC);
  93.     Fill( ADR(DataRegisters), SIZE(DataRegisters), 0);
  94.     DataRegisters[Receiving, DataLeft] := BytesToGo;
  95.     StartTimer(ForTransfer);
  96.     StartTimer(ForPacket);
  97.     IF BytesToGo > 0 THEN
  98.          ShowTimeLeft( Receiving );
  99.     END;
  100. END ShowFileData;
  101.  
  102. PROCEDURE ReadByte(VAR c: BYTE): BOOLEAN;
  103. VAR dat: CARDINAL;
  104. BEGIN
  105.     dat := CommRdData( SendDelay );
  106.     CASE dat OF
  107.     ComAbort: GracefulAbort(AbortMsg);
  108.               RETURN FALSE;
  109. |ComTimedOut: RETURN FALSE;
  110.          ELSE c:= VAL(BYTE, dat);
  111.               RETURN TRUE
  112.    END;
  113. END ReadByte;
  114.  
  115. PROCEDURE ReceiveXmodem( FilePath, FileName : PathStr );
  116.  
  117. TYPE
  118.     RecvStateType = (
  119.          XStart,
  120.          XGet1st,
  121.          XGetName,
  122.          XGetData);
  123.  
  124. VAR
  125.     State : RecvStateType;
  126.     Number,  
  127.     Errors, 
  128.     LastNum : SHORTCARD;
  129.     UseTempName : BOOLEAN;
  130.  
  131. PROCEDURE GetTelinkName(): BOOLEAN;
  132. CONST LastTelinkMsg = 'Last Telink file.';
  133. VAR ch : SHORTCARD; len: SHORTCARD;
  134. BEGIN
  135.     Errors := 0;
  136.     StatusMessage('Getting file information', FALSE);
  137.     LOOP
  138.          LOOP
  139.               CommWrData(nak); 
  140.               IF ReadByte( ch ) THEN 
  141.                    CASE ch OF 
  142.                         ack: EXIT;
  143.                        |eot: CommWrData(ack);
  144.                              StatusMessage(LastTelinkMsg, FALSE);
  145.                              RETURN FALSE
  146.                         ELSE INC (Errors);
  147.                    END
  148.               ELSE 
  149.                    IF Aborting THEN
  150.                         RETURN FALSE
  151.                    END;
  152.                    INC (Errors);
  153.               END;
  154.               IF Errors >= MaxErrors THEN
  155.                    StatusMessage(TimeoutAbortMsg, FALSE);
  156.                    RETURN FALSE
  157.               END
  158.          END;
  159.          CRCvalue := 0;
  160.          len := 0;
  161.          LOOP
  162.               IF ReadByte( ch ) THEN 
  163.                    CASE ch OF sub:
  164.                         INC( CRCvalue, sub );
  165.                         CommWrData( SHORTCARD( CRCvalue ) );
  166.                         IF ReadByte(ch) THEN
  167.                              IF ch = ack THEN
  168.                                   RETURN TRUE
  169.                              END;
  170.                              INC(Errors);
  171.                              EXIT
  172.                         ELSE
  173.               GracefulAbort(NoTransferMsg);
  174.                              RETURN FALSE
  175.                         END;
  176.                    |eot: CommWrData(ack);
  177.                              StatusMessage(LastTelinkMsg, FALSE);
  178.                              RETURN FALSE;
  179.                    ELSE  
  180.                         CommWrData( ack );
  181.                         INC( CRCvalue, ORD(ch) );
  182.                         INC( len );
  183.                         IF len > 12 THEN
  184.               GracefulAbort(NoTransferMsg);
  185.                              RETURN FALSE
  186.                         END;
  187.                    END; (* CASE *)
  188.               ELSE
  189.                    IF NOT Aborting THEN 
  190.                         StatusMessage(NoTransferMsg, FALSE);
  191.                    END;
  192.                    RETURN FALSE
  193.               END
  194.          END;
  195.          INC( Errors );
  196.          IF Errors > MaxErrors THEN
  197.               GracefulAbort(NoTransferMsg);
  198.               RETURN FALSE
  199.          END
  200.      END
  201. END GetTelinkName;
  202.  
  203. PROCEDURE FileParamsSet(): BOOLEAN;
  204. VAR ClusterSize: CARDINAL; Error : BOOLEAN; FileTail: PathTail;
  205.  
  206. BEGIN
  207.     IF ZeroBlock.FileName[0] = 0C THEN
  208.          RETURN FALSE
  209.     END;
  210.     Copy( FileName, ZeroBlock.FileName );
  211.     BytesToGo := ZeroBlock.FileLength;
  212.     IF BytesToGo > 0 THEN
  213.       Error := FALSE;
  214.       WHILE Error OR 
  215.        ( DiskFree( VAL(SHORTCARD,CAP(FilePath[0]) )
  216.        - SHORTCARD('@'), ClusterSize) < BytesToGo ) DO
  217.          IF NOT PromptForString(
  218. 'Insufficient disk space: New directory or Return to cancel', FilePath) THEN
  219.               GracefulAbort(AbortMsg);
  220.               RETURN FALSE
  221.          END;
  222.          FileTail[0] := 0C;
  223.          Error := NOT ParsePath(FilePath, FileTail);
  224.       END;
  225.     END;
  226.     Concat(FileName, FilePath, FileName);
  227.     RETURN TRUE
  228. END FileParamsSet;
  229.  
  230. PROCEDURE FirstLeader() : BOOLEAN;
  231. CONST MaxFLerrs = 20;
  232. VAR ch, FLerrs: SHORTCARD; gotCan: BOOLEAN;
  233. BEGIN
  234.     WHILE CommRdData(0) < 0100H DO END; (* Flush *)
  235.     FLerrs := 0;
  236.     gotCan := FALSE;
  237.     ch := cee;
  238.     REPEAT
  239.          CommWrData(ch); (*request CRC*)
  240.          CASE CommRdDataTest( 2 ) OF
  241.      ComAbort: GracefulAbort(AbortMsg);
  242.            RETURN FALSE;
  243.          |soh : RETURN TRUE;
  244.          |stx : BlockSize := 1024;
  245.                 RETURN TRUE
  246.          |syn : Protocol := Telink;
  247.                 RETURN TRUE;
  248.          |can : IF gotCan THEN
  249.                    StatusMessage(CancelMsg, FALSE);
  250.                    RETURN FALSE
  251.                 END;
  252.                 gotCan := TRUE;
  253.          |eot : CommWrData(ack);
  254.                     (* RETURN FALSE; *)
  255.  |ComTimedOut: StatusMessage(TimeoutMsg, FALSE);
  256.         |ELSE WHILE CommRdData(0) < 0100H DO END; (* Flush *)
  257.          END; (* CASE *)
  258.          INC(FLerrs);
  259.          IF FLerrs = 3 THEN
  260.               ch := nak;
  261.               UsingCRC := FALSE;
  262.               UpdChk := DoCks;
  263.          END
  264.     UNTIL FLerrs >= MaxFLerrs;
  265.     StatusMessage(TimeoutAbortMsg, FALSE);
  266.     RETURN FALSE
  267. END FirstLeader;
  268.  
  269. PROCEDURE SendAck(Good: BOOLEAN);
  270. BEGIN
  271.     IF Good THEN
  272.          CommWrData(ack);
  273.          Errors := 0;
  274.          INC( DataRegisters[TRUE, Packets]);
  275.     ELSE
  276.          WHILE CommRdData(0) < 0100H DO END; (* Flush *)
  277.          CommWrData(nak);
  278.          INC(Errors);
  279.          INC( DataRegisters[TRUE, Errs]);
  280.     END;
  281.     UpdateData;
  282. END SendAck;
  283.  
  284. PROCEDURE NextLeader(): SHORTCARD;
  285. VAR x : CARDINAL;
  286. BEGIN 
  287.     REPEAT 
  288.          CASE CommRdDataTest( SendDelay ) OF
  289.          ComAbort: GracefulAbort(AbortMsg);
  290.                     RETURN 0FFH;
  291.              |soh : BlockSize := 128;
  292.                     RETURN soh;
  293.              |stx : BlockSize := 1024;
  294.                     RETURN soh
  295.              |eot : SendAck(TRUE);
  296.                     RETURN eot;
  297.              |can : x := CommRdData( SendDelay );
  298.                     IF (x >= ComAbort) OR (x = can) THEN
  299.                         StatusMessage(CancelMsg, FALSE);
  300.                         RETURN 0FFH
  301.                     END
  302.     |ComTimedOut:  StatusMessage(TimeoutMsg, FALSE);
  303.                     INC(Errors);
  304.              ELSE WHILE CommRdData(0) < 0100H DO END; (* Flush *)
  305.          END;
  306.          SendAck(FALSE);
  307.     UNTIL Errors > MaxErrors;
  308.     GracefulAbort(TimeoutAbortMsg);
  309.     RETURN 0FFH
  310. END NextLeader;
  311.  
  312. PROCEDURE OpenFile(): BOOLEAN;
  313. BEGIN
  314.     fi := NFIO.Create(FileName);
  315.     IF fi = MAX (CARDINAL) THEN
  316.          GracefulAbort(CreateError);
  317.          RETURN FALSE
  318.     END;
  319.     ShowFileData(FileName, TRUE);
  320.     RETURN TRUE
  321. END OpenFile;
  322.  
  323. PROCEDURE WriteBlock (): BOOLEAN;
  324. VAR ToWrite:CARDINAL;
  325. BEGIN
  326.     IF (Protocol IN SimpleXmProtos) OR (BytesToGo = 0) THEN 
  327.          ToWrite := BlockSize
  328.     ELSE
  329.          IF BytesToGo > VAL( LONGCARD, BlockSize ) THEN 
  330.               ToWrite := BlockSize
  331.          ELSE 
  332.               ToWrite := VAL( CARDINAL, BytesToGo )
  333.          END;
  334.          IF ToWrite = 0 THEN
  335.               RETURN TRUE;
  336.          END
  337.     END;
  338.     IncrDataBytes( ToWrite, TRUE );
  339.     NFIO.WrBin ( fi, Buffer^[1], ToWrite ); 
  340.     IF BytesToGo > 0 THEN
  341.          DEC( BytesToGo, VAL(LONGCARD, ToWrite) )
  342.     END;
  343.     RETURN NFIO.OK
  344. END WriteBlock;
  345.  
  346. TYPE GetResponse = (GetError, GetGood, GetEmpty);
  347.  
  348. PROCEDURE GetBlock(GetType: CHAR; UseCRC:BOOLEAN): GetResponse;
  349. VAR GetOK: BOOLEAN; CrcResult: A2; j : CARDINAL; Complement, i: SHORTCARD;
  350.  
  351. PROCEDURE WriteIt(): GetResponse;
  352. BEGIN
  353.     IF NOT WriteBlock() THEN
  354.          GracefulAbort('Cannot write to disk'); (* send can sted of ack *)
  355.          RETURN GetError
  356.     END;
  357.     SendAck(TRUE);
  358.     RETURN GetGood;
  359. END WriteIt;
  360.  
  361. BEGIN
  362.     IF UseCRC THEN 
  363.          UpdChk := DoCRC
  364.     ELSE
  365.          UpdChk := DoCks
  366.     END;
  367.     IF ReadByte( Number ) AND ReadByte( Complement ) AND
  368.        ( Number + Complement = 255 ) THEN
  369.          IF (Number = (LastNum+1) ) OR (GetType <> 'D') THEN
  370.               FOR j := 1 TO BlockSize DO
  371.                    IF NOT ReadByte( Buffer^[j] ) THEN
  372.                         RETURN GetEmpty
  373.                    END;
  374.               END;
  375.               CRCvalue := UpdChk( Buffer, BlockSize, 0 );
  376.               IF UseCRC THEN
  377.                    FOR j := 0 TO 1 DO 
  378.                         IF NOT ReadByte(CrcResult[j]) THEN 
  379.                              RETURN GetError
  380.                         END;
  381.                    END;
  382.                    CRCvalue := UpdChk( ADR(CrcResult), 2, CRCvalue );
  383.               ELSE
  384.                    IF NOT ReadByte( i ) THEN 
  385.                         RETURN GetError
  386.                    END;
  387.                    DEC( CRCvalue, ORD(i) )
  388.               END;
  389.               GetOK := CRCvalue = 0;
  390.               LastNum := Number;
  391.               IF GetOK THEN 
  392.                    CASE GetType OF
  393.                         'D': RETURN WriteIt();
  394.                        |'0': CASE Number OF 
  395.                              0: State := XGetName;
  396.                                 InterpretBlock[Protocol]( Buffer, ZeroBlock);
  397.                             |1: Protocol := XModem1K;
  398.                    StatusMessage('No file name; saving as XMODEM.$$$', FALSE);
  399.                                 FileName := 'XMODEM.$$$';
  400.                                 BytesToGo := 0;
  401.                                 UseTempName := TRUE;
  402.                                 State := XGetData;
  403.                                 RETURN WriteIt();
  404.                             |ELSE GetOK := FALSE
  405.                         END;
  406.                        |'1': CASE Number OF
  407.                              0: Protocol := YModem;
  408.                                 State := XGetName;
  409.                                 InterpretBlock[Protocol]( Buffer, ZeroBlock);
  410.                             |1: State := XGetData;
  411.                                 RETURN WriteIt();
  412.                            ELSE GetOK := FALSE
  413.                         END
  414.                    END;
  415.               END; (* IF GetOK *)
  416.               SendAck(GetOK);
  417.               RETURN GetResponse(GetOK)
  418.          END;
  419.          WHILE CommRdData(0) < 0100H DO END; (* Flush *)
  420.          SendAck(TRUE);
  421.          RETURN GetResponse(Number = LastNum) (* duplicate block is OK *)
  422.     END;
  423.     WHILE CommRdData(0) < 0100H DO END; (* Flush *)
  424.     SendAck(FALSE);
  425.     RETURN GetError
  426. END GetBlock;
  427.  
  428. BEGIN  (* ReceiveXmodem *)
  429.     WHILE CommRdData(0) < 0100H DO END; (* Flush *)
  430.     FlushLog;
  431.     Aborting := FALSE;
  432.     Protocol := QCDefPtr^.Protocol;
  433.     StartDisplay( TRUE, Protocol, TRUE);
  434.     setXon( FALSE, FALSE );
  435.     NEW ( Buffer );
  436.     UsingCRC := TRUE;
  437.     BlockSize := 128;
  438.     StatusMessage('Ready to receive.', FALSE);
  439.     State := XStart;
  440.     UseTempName := FALSE;
  441.     LOOP
  442.          CASE State OF
  443.       XStart: IF Protocol IN SimpleXmProtos THEN
  444.                    LastNum := 0
  445.               ELSE
  446.                    LastNum := 255
  447.               END;
  448.               Errors := 0;
  449.               IF (Protocol = Telink) AND NOT GetTelinkName() THEN
  450.                    EXIT (* INCLUDES ABORT *)
  451.               END;
  452.               INC(State);
  453.     |XGet1st: IF NOT FirstLeader() THEN
  454.                    EXIT  (* INCLUDES ABORT *)
  455.               END;
  456.               IF (Protocol IN SimpleXmProtos) THEN
  457.                    INC(State)
  458.               ELSE 
  459.                    CASE (GetBlock('0', Protocol <> Telink)) OF
  460.                    GetError: IF Aborting THEN  (* ABORT *)
  461.                                   EXIT
  462.                              ELSIF (Errors > MaxErrors) THEN
  463.                                   StatusMessage(NoTransferMsg, FALSE);
  464.                                   EXIT
  465.                              END;
  466.                   |GetEmpty: EXIT;
  467.               END END; (* ELSE, CASE *)
  468.    |XGetName: IF (Protocol IN ZeroBlockProtos) THEN
  469.                 IF NOT FileParamsSet() THEN
  470.                    EXIT
  471.                 END
  472.               ELSE
  473.                    BytesToGo := 0
  474.               END;
  475.               IF NOT OpenFile() THEN
  476.                    EXIT
  477.               END;
  478.               CASE Protocol OF
  479.          XModem, XModem1K: IF GetBlock('1', UsingCRC) <> GetGood THEN 
  480.                       EXIT  (* INCLUDES ABORT *)
  481.                  END;
  482.         |Telink: INC(State);
  483.         |YModem: IF NOT FirstLeader() THEN 
  484.                       EXIT  (* INCLUDES ABORT *)
  485.                  END;
  486.                  IF GetBlock('D', UsingCRC) <> GetGood THEN
  487.                       EXIT  (* INCLUDES ABORT *)
  488.                  END;
  489.                  INC(State);
  490.               END; (* CASE *)
  491.    |XGetData: CASE NextLeader() OF
  492.               soh: IF GetBlock('D', UsingCRC) <> GetGood THEN
  493.                         EXIT  (* INCLUDES ABORT *)
  494.                    END;
  495.              |eot: IF (Protocol IN ZeroBlockProtos) 
  496.                      AND (ZeroBlock.FileTime > 0)
  497.                      AND SetFileTime(fi,ZeroBlock.FileTime) THEN 
  498.                    END;
  499.                    NFIO.Close(fi); 
  500.                    ShowTransferTime;
  501.                    IF NOT NFIO.OK THEN
  502.                         StatusMessage( CloseError, FALSE);
  503.                         EXIT
  504.                    END;
  505.                    CommWrData(ack);
  506.                    IF Protocol IN SimpleXmProtos THEN  
  507.                         CommWrData(nak); (* ????? CHECK *)
  508.                         IF UseTempName AND PromptForString(
  509.          'New name for file (now XMODEM.$$$): ', FileName) THEN
  510.                             NFIO.Rename('XMODEM.$$$', FileName)
  511.                         END;
  512.                         EXIT
  513.                    ELSE
  514.                         State := XStart
  515.                    END
  516.             |ELSE  EXIT  (* timed out OR ABORT *)
  517.               END (* CASE NextLeader() *)
  518.          END; (* CASE State *)
  519.     END; (* LOOP *)
  520.     DISPOSE( Buffer );
  521.     setXon( TRUE, TRUE );
  522.     StopDisplay;
  523. END ReceiveXmodem;
  524.  
  525. PROCEDURE SendXmodem( ThisFile: FilePtr );
  526. VAR 
  527.   c, Errors, totalErrors: SHORTCARD;
  528.    BlockNum : SHORTCARD;
  529.     FileName : PathTail;
  530.  
  531. PROCEDURE GetAck(seconds: CARDINAL; OKChrs: NUMSET ): SHORTCARD;
  532. VAR c : CARDINAL;
  533. BEGIN
  534.     c := CommRdDataTest( seconds );
  535.     CASE c OF
  536.     ComAbort: GracefulAbort(AbortMsg);
  537.                RETURN esc;
  538. |ComTimedOut: RETURN 0FFH
  539.          |can: c := CommRdDataTest( seconds );
  540.                IF (c >= ComAbort) OR (c = can) THEN
  541.                    UpdateData;
  542.                    RETURN can
  543.                END
  544.     END; (* CASE *)
  545.     IF VAL(SHORTCARD,c) IN OKChrs THEN 
  546.          UpdateData;
  547.          RETURN VAL(SHORTCARD, c)
  548.     END;
  549.     RETURN 0FFH
  550. END GetAck;
  551.  
  552. PROCEDURE SendTelinkName(): BOOLEAN;
  553. VAR i : CARDINAL; ch : SHORTCARD;
  554. BEGIN
  555.     IF GetAck(4*SendDelay, NUMSET{nak}) <>  nak  THEN
  556.          IF NOT Aborting THEN
  557.               StatusMessage(TimeoutAbortMsg, FALSE);
  558.          END;
  559.          RETURN FALSE
  560.     END;
  561.     Errors := 0;
  562.     StatusMessage('Sending file information', FALSE);
  563.     LOOP
  564.          CRCvalue := 0;
  565.          CommWrData(ack); 
  566.          i := 0;
  567.          FOR i := 0 TO Length(FileName) - 1 DO
  568.              CommWrData(FileName[i]);  
  569.              INC( CRCvalue, ORD(FileName[i]) );
  570.              IF GetAck(SendDelay, NUMSET{ack}) <> ack  THEN
  571.                    IF NOT Aborting THEN
  572.                         GracefulAbort(TimeoutAbortMsg)
  573.                    END;
  574.                    RETURN FALSE
  575.              END  
  576.          END;
  577.          CommWrData(sub);
  578.          INC( CRCvalue, sub );
  579.          IF ReadByte(ch) THEN
  580.               IF ch = SHORTCARD(CRCvalue) THEN
  581.                    CommWrData(ack);
  582.                    RETURN TRUE
  583.               ELSE
  584.                    CommWrData(nak);
  585.                    INC (Errors)
  586.               END
  587.          ELSE
  588.               IF NOT Aborting THEN
  589.                    StatusMessage(TimeoutAbortMsg, FALSE);
  590.               END;
  591.               RETURN FALSE
  592.          END;
  593.          IF Errors > MaxErrors THEN
  594.               StatusMessage(TimeoutAbortMsg, FALSE);
  595.               RETURN FALSE
  596.          END
  597.      END
  598. END SendTelinkName;
  599.  
  600. PROCEDURE ReadBlock() : CARDINAL;
  601. VAR result : CARDINAL;
  602. BEGIN
  603.     Fill ( Buffer, SIZE(Buffer^), 32C );
  604.     IF (BlockSize = 1024) AND (BytesToGo >= BlockCrossover) THEN
  605.          Buffer^[1] := stx
  606.     ELSE
  607.          BlockSize := 128;
  608.          Buffer^[1] := soh;
  609.     END;
  610.     Buffer^[2] := BlockNum;
  611.     Buffer^[3] := SHORTCARD(SBITSET(BlockNum) / SBITSET(0FFH));
  612.     result := NFIO.RdBin(fi, Buffer^[4], BlockSize );
  613.     IF NOT NFIO.OK THEN
  614.          RETURN 0
  615.     END;
  616.     RETURN result
  617. END ReadBlock;
  618.  
  619. PROCEDURE BlockSent(size:CARDINAL; UseCRC, Data: BOOLEAN): BOOLEAN;
  620. VAR i: CARDINAL;
  621.  
  622.   PROCEDURE ComputeCRC;
  623.   VAR i: CARDINAL;
  624.   BEGIN
  625.     IF UseCRC THEN
  626.          UpdChk := DoCRC
  627.     ELSE
  628.          UpdChk := DoCks
  629.     END;
  630.     CRCvalue := UpdChk( ADR(Buffer^[4]), size, 0 );
  631.     IF UseCRC THEN
  632.          Buffer^[size + 4] := SHORTCARD( HI(CRCvalue) );
  633.          Buffer^[size + 5] := SHORTCARD( CRCvalue )
  634.     ELSE
  635.          Buffer^[size + 4] := SHORTCARD( CRCvalue );
  636.     END
  637.   END ComputeCRC;
  638.  
  639. BEGIN
  640.     Errors := 0;
  641.     ComputeCRC;
  642.     LOOP
  643.          FOR i := 1 TO size+4+ORD(UseCRC) DO 
  644.               CommWrData(Buffer^[i])
  645.          END;
  646.          CASE GetAck(SendDelay, NUMSET{ack, nak, cee} ) OF
  647.          ack: INC(DataRegisters[FALSE, Packets]);
  648.               IF Data THEN
  649.                    IncrDataBytes( size, FALSE);
  650.                    DEC(BytesToGo, VAL(LONGCARD, size ) );
  651.               END;
  652.               BlockNum := BlockNum + 1;
  653.               EXIT
  654.         |can: StatusMessage(CancelMsg, FALSE);
  655.               RETURN FALSE;
  656.         |esc: 
  657.               RETURN FALSE; (* Abort *)
  658.          ELSE
  659.               INC(DataRegisters[FALSE, Errs]);
  660.               INC(Errors);
  661.               DisplayData( Errs, FALSE );
  662.               IF Errors > MaxErrors THEN
  663.                    GracefulAbort(TimeoutAbortMsg);
  664.                    RETURN FALSE;
  665.               END;
  666.          END; (* CASE *)
  667.       END; (* LOOP *)
  668.       IF BlockSize = 1024 THEN
  669.          INC (totalErrors, Errors );
  670.          IF totalErrors > 2 THEN
  671.               BlockSize := 128;
  672.       StatusMessage('Reducing block size to 128 to reduce delays.', FALSE)
  673.          END
  674.       END;
  675.       RETURN TRUE
  676. END BlockSent;
  677.  
  678. PROCEDURE SendFile;
  679. BEGIN
  680.     BlockNum := 1;
  681.     BytesToGo := NFIO.Size(fi);
  682.     IF (Protocol IN OneKProtos) AND (BytesToGo >= BlockCrossover) THEN 
  683.          BlockSize := 1024
  684.     END;
  685.     ShowFileData(ThisFile^.Name, FALSE);
  686.     WHILE (ReadBlock() > 0) 
  687.       AND BlockSent(BlockSize, UsingCRC, TRUE) DO 
  688.     END;
  689.     ShowTransferTime;
  690. END SendFile;
  691.  
  692. PROCEDURE StartingAck(): BOOLEAN;
  693. BEGIN
  694.     CASE GetAck(4*SendDelay, NUMSET{nak, cee})  OF
  695.          nak: UsingCRC := FALSE;
  696.         |can: StatusMessage(CancelMsg, FALSE);
  697.               RETURN FALSE;
  698.         |esc: RETURN FALSE;     (* Abort by user *)
  699.         |cee: UsingCRC := TRUE;
  700.        |0FFH: GracefulAbort(NoTransferMsg);
  701.               RETURN FALSE;
  702.     END; (* CASE *)
  703.     RETURN TRUE
  704. END StartingAck;
  705.  
  706. BEGIN (* SendXmodem *)
  707.     WHILE CommRdData(0) < 0100H DO END; (* Flush *)
  708.     FlushLog;
  709.     Aborting := FALSE;
  710.     setXon( FALSE, FALSE );
  711.     NEW( Buffer );
  712.     Protocol := QCDefPtr^.Protocol;
  713.     StartDisplay( TRUE, Protocol, FALSE);
  714.     LOOP 
  715.          IF ThisFile = NIL THEN
  716.               BlockSize := 128;
  717.               CASE Protocol OF
  718.                    YModem:
  719.                         BasicBlock( Buffer );
  720.                         IF NOT BlockSent(128, UsingCRC, FALSE) THEN
  721.                            EXIT  (* INCLUDES ABORT *)  
  722.                         END;
  723.                         CommWrData(eot);
  724.                   |Telink: CommWrData(eot);
  725.               END;
  726.               EXIT
  727.          END;
  728.          fi := NFIO.Open(ThisFile^.Name);
  729.          IF fi = MAX( CARDINAL) THEN
  730.               PressKey( OpenError );
  731.          ELSE
  732.               Errors := 0;
  733.               totalErrors := 0;
  734.               IF NOT StartingAck() THEN
  735.                    EXIT;  (* INCLUDES ABORT *)
  736.               END; 
  737.               WHILE CommRdData(0) < 0100H DO END; (* Flush *)
  738.               IF Protocol IN ZeroBlockProtos THEN
  739.                    BlockNum := 0;
  740.                    IF CreateBlock[Protocol]
  741.                       (ThisFile^.Name, FileName, Buffer ) = 0 THEN
  742.                         EXIT
  743.                    END;
  744.                    IF (Protocol = Telink) THEN 
  745.                       IF NOT SendTelinkName() THEN
  746.                         IF NOT Aborting THEN  (* ABORT *)
  747.                              GracefulAbort(NoTransferMsg)
  748.                         END;
  749.                         EXIT
  750.                       ELSIF NOT StartingAck() THEN
  751.                         EXIT  (* INCLUDES ABORT *)
  752.                       END;
  753.                    END; 
  754.                    IF NOT BlockSent(128, 
  755.                      UsingCRC AND (Protocol <> Telink), FALSE ) THEN 
  756.                         IF NOT Aborting THEN
  757.                              GracefulAbort(NoTransferMsg)
  758.                         END;
  759.                         EXIT
  760.                    ELSIF (Protocol = YModem) AND (NOT StartingAck()) THEN
  761.                         IF NOT Aborting THEN
  762.                              GracefulAbort(NoTransferMsg)
  763.                         END;
  764.                         EXIT
  765.                    END;
  766.               END;
  767.               SendFile;
  768.               IF Aborting THEN
  769.                    EXIT
  770.               END;
  771.               Errors := 0;
  772.               REPEAT
  773.                    CommWrData(eot);
  774.                    c := GetAck(SendDelay, NUMSET{ack});
  775.                    IF c <> ack THEN (* INCLUDES ABORT *)
  776.                         INC(Errors)
  777.                    END
  778.               UNTIL (c IN NUMSET{ack, can, esc}) OR (Errors >= MaxErrors);
  779.               NFIO.Close(fi);
  780.               WHILE CommRdData(0) < 0100H DO END; (* Flush *)
  781.          END; (* ELSE *)
  782.          FlushLog;
  783.          ThisFile := ThisFile^.Next
  784.     END; (* LOOP *)
  785.     DISPOSE( Buffer );
  786.     setXon( TRUE, TRUE );
  787.     StopDisplay;
  788. END SendXmodem;
  789.  
  790. END QCxm.
  791.